home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / DOSGOALT.4TH < prev    next >
Text File  |  1994-10-30  |  5KB  |  148 lines
  1. \ COPYRIGHT 1994 BY THOMAS ALMY.  ALL RIGHTS RESERVED
  2. \ Permission is granted to registered users of ForthCMP to
  3. \ sell or distrubute computer programs incorporating the compiled
  4. \ contents of this file.
  5. \ MS is a trademark of Microsoft Corporation.
  6. \ This file is for standard MS-DOS operation, with or without a
  7. \  separate stack segment.
  8.  
  9. \ This is a modified DOSGO which incorporates the exception wordset
  10. \ and has handlers built in for divide by zero, control-C, and control-BREAK
  11. \ traps. It serves as an example of how the startup file can be modified
  12. \ for specific applications, but you might want to replace the existing DOSGO
  13. \ with this one if you want the exception handling.
  14. \ Note that the program must be exited via BYE (or bye) or via normal return
  15. \ from MAIN (don't use the return 0 trick!), or you can exit via ABORT
  16. \ (assuming you don't catch ABORT's  THROW).
  17.  
  18. 10  
  19.  
  20. DECIMAL        \ Values used by THROW
  21. -1  CONSTANT Abort
  22. -28 CONSTANT Ctrl-C      ( User interrupt )
  23.  28 CONSTANT Ctrl-Break  ( Not defined by standard )
  24. -10 CONSTANT 0Divide
  25. HEX
  26. 23 CONSTANT cc-int  ( Control-C software interrupt number from DOS)
  27. 1B CONSTANT cb-int  ( Control-Break software interrupt from BIOS)
  28. 0  CONSTANT /0-int  ( Zero Divide interrupt )
  29.  
  30. 0 0 IN/OUT NEED m1
  31. 0 0 IN/OUT NEED rst
  32. NEED MAIN
  33. ASM FWD,  ( skip the variables )
  34. VARIABLE DP       ( start free ram = HERE, set by END command )
  35. VARIABLE S0       ( top of stack )
  36. VARIABLE R0       ( top of return stack )
  37. VARIABLE BASE     ( radix )     0A BASE !  ( decimal )
  38. 2VARIABLE /0-save  ( we will want to save the vectors )
  39. 2VARIABLE cb-save
  40. THEN,
  41. SEPSSEG? [IF] AX CS <SEG pssize # AX ADD AX SS >SEG [THEN]
  42. FIND PSIZE [IF] DROP ( PSIZE is constant size of program seg)
  43. PSIZE 0 10. D+ 10 SM/REM NIP
  44. DUP 10 * rssize - DUP # SP MOV  ( set param stack )
  45.   CELL- # S0 [] MOV  ( set S0 )
  46. DUP 10 * # BP MOV  BP R0 [] MOV  ( set return stack, R0 )
  47. 4A # AH MOV  SEPSSEG? [IF] pssize + [THEN] # BX MOV  21 INT   [THEN]
  48. FIND PSIZE [IF] DROP [ELSE]
  49. rssize NEGATE DUP # SP MOV  ( set param stack )
  50.   CELL- # S0 [] MOV  ( set S0 )
  51. 0 # BP MOV  BP R0 [] MOV  ( set return stack, R0 ) [THEN]
  52. CLD CALL' m1  ( call main program )
  53. CODE bye 
  54. CALL' rst  ( restore the interrupt handlers )
  55. 4C00 # AX MOV 21 INT END-CODE
  56.  
  57. INCLUDE INTS    \ Interrupt handlers
  58.  
  59. \ We have included exceptio.4th here so we could modify the
  60. \ definition of THROW
  61.  
  62. VARIABLE exfp    \ Exception frame pointer
  63.  
  64. CODE CATCH 
  65.   SI POP  AX POP  \ retAddr execAddr
  66.   BP DEC BP DEC SI [BP] MOV
  67.   BP DEC BP DEC SP [BP] MOV
  68.   BP DEC BP DEC exfp [] BX MOV  BX [BP] MOV
  69.   BP exfp [] MOV
  70.   AX CALLI
  71.   [BP] AX MOV  AX exfp [] MOV  
  72.   AX AX XOR  AX PUSH
  73.   4 +[BP] AX MOV  6 # BP ADD  
  74.   AX JMPI
  75. END-CODE
  76.  
  77. 1 0 IN/OUT
  78. CODE throw
  79.   exfp [] BP MOV [BP] BX MOV BX exfp [] MOV
  80.   2 +[BP] SP MOV  AX PUSH
  81.   4 +[BP] AX MOV
  82.   6 # BP ADD  AX JMPI
  83. END-CODE
  84.  
  85. 1 0 IN/OUT
  86. : THROW ?DUP IF throw THEN ;
  87. 0 0 IN/OUT
  88. : ABORT Abort THROW ;
  89.  
  90. \ CONTROL-C HANDLER
  91.  
  92. L: cc-entry ( actual interrupt handler )
  93.   DECIMAL Ctrl-C HEX # AX MOV   AX PUSH 
  94.   CALL' THROW  \ Never returns
  95.  
  96.  
  97. \ CONTROL-BREAK HANDLER (sets flag)
  98. VARIABLE brk
  99. L: cb-entry ( actual interrupt handler )
  100.   ( save registers )
  101.     AX PUSH  DS PUSHSEG  AX CS <SEG  AX DS >SEG    \ save AX, DS, set DS
  102.     -1 # brk [] MOV  \ set flag
  103.     DS POPSEG  AX POP
  104.     IRET FORTH
  105.  
  106. L: /0-entry  
  107.     0Divide # AX MOV AX PUSH 
  108.         CALL' THROW
  109.  
  110. 0 0 IN/OUT
  111. : m1 \ hidden MAIN
  112.     /0-int get-handler /0-save 2!        \ get and save old handlers
  113.     cb-int get-handler cb-save 2!
  114.     ?CS: cc-entry cc-int set-handler    \ set handlers to us
  115.     ?CS: cb-entry cb-int set-handler
  116.     ?CS: /0-entry /0-int set-handler
  117.     ['] MAIN CATCH CASE
  118.              0 OF  EXIT ENDOF \ Normal finish
  119.              Abort OF S" Abort" ENDOF
  120.              Ctrl-C OF S" Control-C" ENDOF
  121.              Ctrl-Break OF S" Control-Break" ENDOF
  122.              0Divide OF S" Divide by zero" ENDOF
  123.              DECIMAL . S" ? uncaught" 0 ENDCASE
  124.            TYPE ."  exception--Quiting Program" CR
  125. ;
  126. 0 0 IN/OUT
  127. : rst \ restore handlers
  128.     /0-save 2@ /0-int set-handler        \ restore handlers
  129.     ( We dont need to restore the control-C handler )
  130.     cb-save 2@ cb-int set-handler
  131. ;
  132.  
  133. \ We will handle control-break by intercepting BDOS and  EMIT
  134. \ 
  135. VARIABLE of 1 of !
  136. CODE BDOS 
  137.    0 # brk [] CMP =0 ~ IF,  0 # brk [] MOV
  138.        Ctrl-Break # AX MOV AX PUSH CALL' THROW THEN,
  139.    AL AH MOV BX DX MOV 21 INT AH AH XOR RET END-CODE
  140. HERE 1 ALLOT
  141. CODE EMIT 
  142.    0 # brk [] CMP =0 ~ IF,  0 # brk [] MOV
  143.        Ctrl-Break # AX MOV AX PUSH CALL' THROW THEN,
  144.    AL OVER [] MOV 40 # AH MOV 1 # CX MOV DUP # DX MOV
  145.    of [] BX MOV 21 INT RET END-CODE DROP
  146.  
  147. FORTH  0A = [IF] DECIMAL [THEN]
  148.